home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
CMPLTPAS
/
CREATLBL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-07-14
|
4KB
|
84 lines
{->>>>CreateLabel<<<<------------------------------------------}
{ }
{ Filename : CREATLBL.SRC -- Last Modified 7/11/88 }
{ }
{ This procedure creates a new volume label on the unlabeled }
{ DOS volume passed in DriveSpec. No check is made }
{ as to the validity of the character in DriveSpec; if there }
{ is no corresponding drive the system may hang or return an }
{ error depending on the specifics. If a volume label already }
{ exists on the specified volume, CreatedLabel will return }
{ FALSE with an ErrorReturn value of 0. This is not really an }
{ error condition, but DOS makes no provision for altering a }
{ volume label that already exists, so at best we go home with }
{ our tail between our legs. If some sort of true error }
{ occurs, the DOS error code will be returned in ErrorReturn, }
{ and CreatedLabel will be set to FALSE. If CreatedLabel }
{ comes back TRUE, the label was in fact created. }
{ }
{ Function GetLabel must be predefined. }
{ }
{ From: COMPLETE TURBO PASCAL 5.0 by Jeff Duntemann }
{ Scott, Foresman & Co., Inc. 1988 ISBN 0-673-38355-5 }
{--------------------------------------------------------------}
PROCEDURE CreateLabel(DriveSpec : String;
NewLabel : String;
VAR CreatedLabel : Boolean;
VAR ErrorReturn : Word;
ShowError : Boolean);
TYPE
ErrorCode = 0..18; { DOS function call error codes }
String80 = String[80];
VAR
I : Integer;
SearchSpec : String80;
FileSpec : String80;
CurrentLabel : String80;
Regs : Registers;
ASCIIZ : ARRAY[1..81] OF Char;
DTA : SearchRec;
Error : ErrorCode;
FoundLabel : Boolean;
BEGIN
CurrentLabel := GetLabel(DriveSpec,FoundLabel);
IF NOT FoundLabel THEN { No label exists yet }
BEGIN
FileSpec := DriveSpec + '\' + NewLabel + Chr(0);
Move(FileSpec[1],ASCIIZ,Sizeof(FileSpec));
WITH Regs DO
BEGIN
AH := $3C; { $3C = Create File }
DS := Seg(ASCIIZ); { Put address of ASCIIZ }
DX := Ofs(ASCIIZ); { in DS : DX }
CL := $08; { Set Volume Label attribute }
END;
MSDOS(Regs); { Make CHMOD DOS call }
{ If the Carry Flag is found to be set, it's an error: }
IF (Regs.Flags AND $0001) = 1 THEN
BEGIN
CreatedLabel := False; { No luck }
ErrorReturn := Regs.AX; { Return error code as parameter }
Error := ErrorReturn; { Make an ordinal of the error code }
IF ShowError THEN
CASE Error OF
2 : Writeln('Label file not found.');
3 : Writeln('Bad path error -- possible disk failure.');
5 : Writeln('Access to label denied -- Disk write protected?');
ELSE Writeln('Unexpected DOS error ',Error,' on label write.')
END; { CASE }
END
ELSE CreatedLabel := True { No error - created the label }
END
ELSE { Label already exists; can't re-create it... }
BEGIN
CreatedLabel := False;
ErrorReturn := 0;
END
END;